perm filename NTS.F4[P11,LCS] blob
sn#583812 filedate 1981-05-02 generic text, type T, neo UTF8
SUBROUTINE NTS
COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
COMMON /POSI/STFF(0/7),JJ2,POS
C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,
1 PUNCT,JY,RJ
EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8)),
1(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9)),(JSTEM,JQ(20))
1,(R8,RJQ(6)),(R7,RJQ(5)),(RJZ,RJQ(20)),(R3,RJQ(1))
1,(RX4,JQ(19)),(R12,RJQ(10))
DATA WID1/14.54/,WID2/16.2/
C NOTES****
JSTEM=J5/10
JY=IABS(J6)
IF(JY.EQ.30)JY=0
C 30 IS USED IN NOTBMS & RHYTH.
IF(R11.EQ.0)GO TO 10
C SORT IT OUT IN NTSB
R6=-1.
GO TO 1
10 IF(R6.EQ.0)GO TO 1
R6=ABS(AMOD(R6,1.0))*10.
C R6 WILL HAVE ACCENT CODE # (.7=DOT, ETC.)
1 L=IABS(J4)
RJAC=R3
C TO SAVE POS. OF NOTE FOR ACCENT
RZTM=2.*RSTJ2
1010 IF(J10.LE.0)GO TO 1110
POS=STFF(J2-3+2*J10)
C FOR PUTTING NOTES ON STAFF ABOVE OR BELOW. J10=1=DOWN, =2=UP
CALL CENTX
1110 IF(L.LT.80)GO TO 1013
C MINIS= 80→179 OR -100→-120
IF(L.LT.180)GO TO 1012
C DIAMOND NTS=180→279
RZTM=0
IF(L.GE.280)GO TO 1014
C X NTS=280→379
KL=8
RG=12.0
C FOR DIAMOND NOTES.
GO TO 1013
C STEM ONLY NTS=380→479
1014 IF(L.GE.380)GO TO 1016
RJX=RMINI*7.
C FOR "X" NOTES
KL=13
RG=16.
RB=RJX
IF(JSTEM.EQ.2)RB=-RB
RB=RB+CENTR
GO TO 1013
1016 IF(L.GE.10000)GO TO 1013
1019 IF(L.GE.480)GO TO 1017
RB=CENTR+R12*RST7
C +400 = NO NOTE HEAD. P12 CAN ADJUST SOURCE OF STEM.
GO TO 1013
1017 CALL EXTRA
C GO USE SPECIAL NOTE PACKAGE
RETURN
C 'EXTRA' IS FOR USER-ADDED NOTE AND REST SHAPES. P4+ 480→ (OR 600 TOO?)
C 480 IS USED SO NOTES CAN BE AT 500-19
1012 RMINI=.6*RSTJ2
C FOR RMINI NOTES, MINI TAILS AND ACCIS. ETC.
1013 J4=R4
RX4=R4
RJZ=R4
C RJZ FOR FLAT, #, NAT. RX4 FOR TR., HARM, ETC.
IF(JY.LT.10)GO TO 2221
RQ=WID1
IF(L.GE.180)GO TO 2
IF(J6.LT.0)RQ=WID2
C WHITE NOTE WIDTH=WID2
C P6 FOR HOMING TO RIGHT(10) OR LEFT(20) OF STEM(10=UP, 20=DOWN)
C P6<0 = WHITE NOTE GETS WIDTH OF NOTE DISPLACEMENT
2 IF(JY.EQ.20)RQ=-RQ
R3=R3+RQ*RMINI
2221 IF(J4.LE.1)GO TO 322
IF(J4.LT.13)GO TO 1121
322 IF(J9.NE.-1)CALL NTS4
C NTS4 MAKES LEDGER LINES. J9=-1 SUPRESSES THEM.
C J9<-1 MAKES LEDGER LINES, BUT WILL NOT JUSTIFY.
1121 IF(L.LT.380)CALL NTS5
CALL NTS2
END